home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2004 #2 / Amiga Plus CD - 2004 - No. 02.iso / AmigaPlus / Tools / Development / AmigaTalk / intuition / Gadget.st < prev    next >
Encoding:
Text File  |  2004-01-31  |  10.2 KB  |  484 lines
  1. "-----------------------------------------------------------------------"
  2. " Gadget Class is an Abstract class for Intuition Gadgets.              "
  3. "-----------------------------------------------------------------------"
  4.  
  5. Class Gadget :Glyph ! intuition !
  6. [
  7.    getGadgetObject   " After all, this is an ABSTRACT CLASS!! "
  8.  
  9.       super subclassResponsibility: 'getGadgetObject'.
  10.  
  11.       ^ nil
  12. |
  13.    isDisabled: thisGadget ! mask !
  14.  
  15.       (intuition isNil)
  16.          ifTrue: [ intuition <- Intuition new ].
  17.          
  18.       mask <- (intuition systemTag: #GFLG_DISABLED).
  19.  
  20.       (mask and: [<primitive 183 2 4 thisGadget>])
  21.          ifTrue: [ ^ true ].
  22.  
  23.       ^ false
  24. |
  25.    isSelected: thisGadget ! mask !
  26.  
  27.       (intuition isNil)
  28.          ifTrue: [ intuition <- Intuition new ].
  29.          
  30.       mask <- (intuition systemTag: #GFLG_SELECTED).
  31.  
  32.       (mask and: [<primitive 183 2 4 thisGadget>])
  33.          ifTrue: [ ^ true ].
  34.  
  35.       ^ false
  36. |
  37.    "only needed because of GZZGADGET & REQGADGET type flags."
  38.    gadgetTypeIs: thisGadget
  39.  
  40.       ^ <primitive 183 2 6 thisGadget>
  41. |
  42.    dispose: thisGadget
  43.  
  44.       <primitive 183 0 thisGadget>.
  45.       
  46.       <primitive 250 5 0 thisGadget>.
  47.       
  48.       ^ nil
  49. |
  50.    setStartPoint: thisGadget to: newPoint ! x y !  "newPoint  is leftEdge @ topEdge"
  51.  
  52.       x <- newPoint x.
  53.       y <- newPoint y.
  54.  
  55.       <primitive 183 3 0 x thisGadget>.
  56.       <primitive 183 3 1 y thisGadget>.
  57. |
  58.    setGadgetSize: thisGadget to: sizePoint ! w h ! "sizePoint is width @ height"
  59.  
  60.       w <- sizePoint x.
  61.       h <- sizePoint y.
  62.  
  63.       <primitive 183 3 2 w thisGadget>.
  64.       <primitive 183 3 3 h thisGadget>
  65. |
  66.    getStartPoint: thisGadget ! leftEdge topEdge !
  67.  
  68.       leftEdge <- <primitive 183 2 0 thisGadget>.
  69.       topEdge  <- <primitive 183 2 1 thisGadget>.
  70.  
  71.       ^ leftEdge @ topEdge
  72. |
  73.    getGadgetSize: thisGadget ! width height !
  74.  
  75.       width  <- <primitive 183 2 2 thisGadget>.
  76.       height <- <primitive 183 2 3 thisGadget>.
  77.  
  78.       ^ width @ height
  79. |
  80.    getGadgetUserData: thisGadget
  81.  
  82.       ^ <primitive 183 2 19 thisGadget>
  83. |
  84.    setGadgetUserData: thisGadget to: newData
  85.  
  86.       <primitive 183 3 12 newData thisGadget>
  87. ]
  88.  
  89. "-----------------------------------------------------------------------"
  90. " BoolGadget Class implements messages specific only to boolean gadgets."
  91. "-----------------------------------------------------------------------"
  92.  
  93. Class BoolGadget :Gadget ! private userData !
  94. [
  95.    dispose
  96.  
  97.       super dispose: private.
  98.  
  99.       ^ nil
  100. |
  101.    isDisabled
  102.  
  103.       ^ (super isDisabled: private)
  104. |
  105.    isSelected
  106.  
  107.       ^ (super isSelected: private)
  108. |
  109.    gadgetTypeIs
  110.  
  111.       ^ (super gadgetTypeIs: private)
  112. |
  113.    "only needed because of GZZGADGET & REQGADGET type flags."
  114.    setGadgetType: newGadgetType
  115.  
  116.       <primitive 183 3 6 newGadgetType private>
  117. |
  118.    getGadgetObject
  119.  
  120.       ^ private
  121. |
  122.    setStartPoint: newPoint "newPoint  is leftEdge @ topEdge"
  123.  
  124.       super setStartPoint: private to: newPoint.
  125.  
  126.       ^ newPoint
  127. |   
  128.    setGadgetSizeTo: sizePoint
  129.  
  130.       super setGadgetSize: private to: sizePoint.
  131.       
  132.       ^ sizePoint
  133. |
  134.    getStartPoint
  135.  
  136.       ^ (super getStartPoint: private)
  137. |
  138.    getGadgetSize
  139.  
  140.       ^ (super getGadgetSize: private)
  141. |
  142.    getFlags
  143.  
  144.       ^ <primitive 183 2 4 private>
  145. |
  146.    setFlags: newFlags
  147.  
  148.       <primitive 183 3 4 newFlags private>
  149. |
  150.    getActivation
  151.  
  152.       ^ <primitive 183 2 5 private>
  153. |
  154.    setActivation: newActivation
  155.  
  156.       <primitive 183 3 5 newActivation private>
  157. |
  158.    getGadgetID
  159.  
  160.       ^ <primitive 183 2 7 private>
  161. |
  162.    setGadgetID: newGadgetID
  163.  
  164.       <primitive 183 3 7 newGadgetID private>
  165. |
  166.    getNextGadget
  167.  
  168.       ^ <primitive 183 2 8 private>
  169. |
  170.    setNextGadget: newNextGadgetObject
  171.  
  172.       <primitive 183 3 8 newNextGadgetObject private>
  173. |
  174.    getITextString
  175.  
  176.       ^ <primitive 183 2 9 private>
  177. |
  178.    getGadgetText            " which is an IntuiText Object "
  179.  
  180.       ^ <primitive 183 2 18 private>
  181. |
  182.    setGadgetText: newIntuiTextObject
  183.  
  184.       <primitive 183 3 9 newIntuiTextObject private>
  185. |
  186.    getRenderObject
  187.  
  188.       ^ <primitive 183 2 10 private>
  189. |
  190.    setRender: newRenderObject " Either an Image, Border or IntuiText! "
  191.  
  192.       <primitive 183 3 10 newRenderObject private>.
  193. |
  194.    getSelectObject
  195.  
  196.       ^ <primitive 183 2 11 private>
  197. |
  198.    setSelect: newSelectObject " Either an Image, Border or IntuiText! "
  199.  
  200.       <primitive 183 3 11 newSelectObject private>
  201. |
  202.    getUserData ! rval !
  203.  
  204.       rval <- super getGadgetUserData: self.
  205.  
  206.       ^ (rval at: 2)
  207. |
  208.    getGadgetValue ! rval !
  209.  
  210.       rval <- super getGadgetUserData: self.
  211.  
  212.       ^ (rval at: 1)
  213. |
  214.    setUserMethod: methodSymbol
  215.  
  216.       userData at: 2 put: methodSymbol
  217. |
  218.    new
  219.  
  220.       private  <- <primitive 183 1>.
  221.  
  222.       userData <- Array new: 3.
  223.       
  224.       self setGadgetType: 1.
  225.  
  226.       super setGadgetUserData: self to: userData.
  227.       
  228.       ^ self
  229. ]
  230.  
  231. "---------------------------------------------------------------------"
  232. " StrGadget Class implements messages specific only to string gadgets."
  233. "---------------------------------------------------------------------"
  234.  
  235. Class StrGadget :Gadget ! private userData !
  236. [
  237.    dispose
  238.       super dispose: private.
  239.  
  240.       ^ nil
  241. |
  242.    isDisabled
  243.       ^ (super isDisabled: private)
  244. |
  245.    isSelected
  246.       ^ (super isSelected: private)
  247. |
  248.    gadgetTypeIs
  249.       ^ (super gadgetTypeIs: private)
  250. |
  251.    setStartPoint: newPoint "newPoint  is leftEdge @ topEdge"
  252.       super setStartPoint: private to: newPoint.
  253.  
  254.       ^ newPoint
  255. |   
  256.    setGadgetSizeTo: sizePoint
  257.       super setGadgetSize: private to: sizePoint.
  258.       
  259.       ^ sizePoint
  260. |
  261.    getStartPoint
  262.       ^ (super getStartPoint: private)
  263. |
  264.    getGadgetSize
  265.       ^ (super getGadgetSize: private)
  266. |
  267.    setBufferSize: newSize
  268.       <primitive 183 5 newSize private>
  269. |
  270.    getBufferSize
  271.       ^ <primitive 183 2 12 private>
  272. |
  273.    getFlags
  274.       ^ <primitive 183 2 4 private>
  275. |
  276.    setFlags: newFlags
  277.       <primitive 183 3 4 newFlags private>
  278. |
  279.    getActivation
  280.       ^ <primitive 183 2 5 private>
  281. |
  282.    setActivation: newActivation
  283.       <primitive 183 3 5 newActivation private>
  284. |
  285.    setGadgetType: newGadgetType
  286.       <primitive 183 3 6 newGadgetType private>.
  287. |
  288.    getGadgetID
  289.       ^ <primitive 183 2 7 private>
  290. |
  291.    setGadgetID: newGadgetID
  292.       <primitive 183 3 7 newGadgetID private>
  293. |
  294.    getNextGadget
  295.       ^ <primitive 183 2 8 private>
  296. |
  297.    setNextGadget: newNextGadgetObject
  298.       <primitive 183 3 8 newNextGadgetObject private>
  299. |
  300.    getITextString
  301.       ^ <primitive 183 2 9 private>
  302. |
  303.    getGadgetText
  304.       ^ <primitive 183 2 18 private>
  305. |
  306.    setGadgetText: newIntuiTextObject
  307.       <primitive 183 3 9 newIntuiTextObject private>
  308. |
  309.    getRender
  310.       ^ <primitive 183 2 10 private>
  311. |
  312.    setRender: newRenderObject " Either an Image or IntuiText! "
  313.       <primitive 183 3 10 newRenderObject private>
  314. |
  315.    getSelect
  316.       ^ <primitive 183 2 11 private>
  317. |
  318.    setSelect: newSelectObject " Either an Image or IntuiText! "
  319.       <primitive 183 3 11 newSelectObject private>
  320. |
  321.    getGadgetObject
  322.       ^ private
  323. |
  324.    getUserData ! rval !
  325.       rval <- super getGadgetUserData: self.
  326.  
  327.       ^ (rval at: 2)
  328. |
  329.    getGadgetValue ! rval !
  330.       rval <- super getGadgetUserData: self.
  331.  
  332.       ^ (rval at: 1)
  333. |
  334.    setUserMethod: methodSymbol
  335.       userData at: 2 put: methodSymbol
  336. |
  337.    new
  338.       private  <- <primitive 183 1>.
  339.       userData <- Array new: 3.
  340.        
  341.       self setGadgetType: 4.
  342.       
  343.       super setGadgetUserData: self to: userData.
  344.       
  345.       ^ self
  346. ]
  347.  
  348. "------------------------------------------------------"
  349. " PropGadget Class implements messages specific only to"
  350. " proportional gadgets.                                "
  351. "------------------------------------------------------"
  352.  
  353. Class PropGadget :Gadget ! private userData !
  354. [
  355.    dispose
  356.       super dispose: private.
  357.  
  358.       ^ nil
  359. |
  360.    isDisabled
  361.       ^ (super isDisabled: private)
  362. |
  363.    isSelected
  364.       ^ (super isSelected: private)
  365. |
  366.    gadgetTypeIs
  367.       ^ (super gadgetTypeIs: private)
  368. |
  369.    "only needed because of GZZGADGET & REQGADGET type flags."
  370.    setGadgetType: newGadgetType
  371.       <primitive 183 3 6 newGadgetType private>
  372. |
  373.    getGadgetObject
  374.       ^ private
  375. |
  376.    setStartPoint: newPoint "newPoint  is leftEdge @ topEdge"
  377.       super setStartPoint: private to: newPoint.
  378.  
  379.       ^ newPoint
  380. |   
  381.    setGadgetSizeTo: sizePoint
  382.       super setGadgetSize: private to: sizePoint.
  383.       
  384.       ^ sizePoint
  385. |
  386.    getStartPoint
  387.       ^ (super getStartPoint: private)
  388. |
  389.    getGadgetSize
  390.       ^ (super getGadgetSize: private)
  391. |
  392.    modifyProps: newFlags hPot: hp vPot: vp hBody: hb
  393.                 vBody: vb window: windowObject
  394.  
  395.       <primitive 183 4 newFlags hp vp hb vb windowObject private>.
  396. |
  397.    setProps: newFlags hPot: hp vPot: vp hBody: hb vBody: vb
  398.  
  399.       <primitive 183 6 newFlags hp vp hb vb private>
  400. |
  401.    getFlags
  402.       ^ <primitive 183 2 4 private>
  403. |
  404.    setFlags: newFlags
  405.       <primitive 183 3 4 newFlags private>
  406. |
  407.    getActivation
  408.       ^ <primitive 183 2 5 private>
  409. |
  410.    setActivation: newActivation
  411.       <primitive 183 3 5 newActivation private>
  412. |
  413.    getGadgetID
  414.       ^ <primitive 183 2 7 private>
  415. |
  416.    setGadgetID: newGadgetID
  417.       <primitive 183 3 7 newGadgetID private>
  418. |
  419.    getNextGadget
  420.       ^ <primitive 183 2 8 private>
  421. |
  422.    setNextGadget: newNextGadgetObject
  423.       <primitive 183 3 8 newNextGadgetObject private>
  424. |
  425.    getITextString
  426.       ^ <primitive 183 2 9 private>
  427. |
  428.    getGadgetText
  429.       ^ <primitive 183 2 18 private>
  430. |
  431.    setGadgetText: newIntuiTextObject
  432.       <primitive 183 3 9 newIntuiTextObject private>
  433. |
  434.    getRender
  435.       ^ <primitive 183 2 10 private>
  436. |
  437.    setRender: newRenderObject " Either an Image or IntuiText! "
  438.       <primitive 183 3 10 newRenderObject private>
  439. |
  440.    getSelect
  441.       ^ <primitive 183 2 11 private>
  442. |
  443.    setSelect: newSelectObject " Either an Image or IntuiText! "
  444.       <primitive 183 3 11 newSelectObject private>
  445. |
  446.    getPropFlags
  447.       ^ <primitive 183 2 13 private>
  448. |
  449.    getHPot
  450.       ^ <primitive 183 2 14 private>
  451. |
  452.    getVPot
  453.       ^ <primitive 183 2 15 private>
  454. |
  455.    getHBody
  456.       ^ <primitive 183 2 16 private>
  457. |
  458.    getVBody
  459.       ^ <primitive 183 2 17 private>
  460. |
  461.    getUserData ! rval !
  462.       rval <- super getGadgetUserData: self.
  463.  
  464.       ^ (rval at: 2)
  465. |
  466.    getGadgetValue ! rval !
  467.       rval <- super getGadgetUserData: self.
  468.  
  469.       ^ (rval at: 1)
  470. |
  471.    setUserMethod: methodSymbol
  472.       userData at: 2 put: methodSymbol
  473. |
  474.    new
  475.       private  <- <primitive 183 1>.
  476.       userData <- Array new: 3.
  477.       
  478.       self setGadgetType: 3.
  479.  
  480.       super setGadgetUserData: self to: userData.
  481.       
  482.       ^ self
  483. ]
  484.